home *** CD-ROM | disk | FTP | other *** search
/ Input 64 / Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64 / macros .lsp < prev    next >
Encoding:
Text File  |  1988-01-01  |  3.1 KB  |  99 lines
  1. (expand expr (lambda nil (setq 
  2. macro-expansion t)))
  3. (no-expand expr (lambda nil (setq 
  4. macro-expansion nil)))
  5. (macro-expansion value t)
  6. (for macro (nlambda l (replace l (
  7. prog (var von nach count-fn test-fn) (
  8. setq var (cadr l)) (setq von (eval (
  9. car (cddr l)))) (setq nach (eval (
  10. cadr (cddr l)))) (cond ((greaterp von 
  11. nach) (setq test-fn (quote lessp)) (
  12. setq count-fn (quote sub1))) (t (setq 
  13. test-fn (quote greaterp)) (setq 
  14. count-fn (quote add1)))) (return (
  15. list (quote prog) (list var) (list (
  16. quote setq) var von) (quote loop) (
  17. list (quote cond) (list (list test-fn 
  18. var nach) (quote (return nil))) (cons 
  19. (quote t) (cddr (cddr l)))) (list (
  20. quote setq) var (list count-fn var)) (
  21. quote (go loop))))))))
  22. (selectq macro (nlambda l (replace l (
  23. cons (quote cond) ((label selectq1 (
  24. lambda (x l) (cond ((atom (cdr l)) (
  25. list (list (quote t) (car l)))) (t (
  26. cons (cons (list (cond ((atom (caar l)
  27. ) (quote eq)) (t (quote member))) x (
  28. list (quote quote) (caar l))) (cdar l)
  29. ) (selectq1 x (cdr l))))))) (cadr l) (
  30. cddr l))))))
  31. (replace expr (lambda (x y) (cond (
  32. macro-expansion (rplaca x (car y)) (
  33. rplacd x (cdr y))) (t y))))
  34. (if macro (mlambda l (replace l (list 
  35. (quote cond) (list (cadr l) (car (
  36. cddr l))) (cons (quote t) (cdr (cddr 
  37. l)))))))
  38. (while macro (mlambda l (replace l (
  39. list (quote prog) nil (quote loop) (
  40. list (quote cond) (list (list (quote 
  41. not) (cadr l)) (list (quote return) 
  42. nil)) (cons (quote t) (cddr l))) (
  43. quote (go loop))))))
  44. (repeat macro (mlambda l (replace l (
  45. list (quote prog) (quote (n)) (list (
  46. quote setq) (quote n) (eval (cadr l)))
  47.  (quote loop) (list (quote cond) (
  48. list (quote (zerop n)) (quote (return 
  49. nil))) (cons (quote t) (cddr l))) (
  50. quote (setq n (sub1 n))) (quote (go 
  51. loop))))))
  52. (let macro (mlambda l (replace l (
  53. cons (cons (quote lambda) (cons (
  54. mapcar (quote car) (cadr l)) (cddr l))
  55. ) (mapcar (quote cadr) (cadr l))))))
  56. (local macro (mlambda l (replace l (
  57. cons (cons (quote lambda) (cdr l)) 
  58. nil))))
  59. (incr macro (mlambda l (replace l (
  60. list (quote setq) (cadr l) (list (
  61. quote add1) (cadr l))))))
  62. (decr macro (mlambda l (replace l (
  63. list (quote setq) (cadr l) (list (
  64. quote sub1) (cadr l))))))
  65. (push macro (nlambda l (replace l (
  66. list (quote setq) (cadr l) (list (
  67. quote cons) (car (cddr l)) (cadr l))))
  68. ))
  69. (pop macro (nlambda l (replace l (
  70. list (quote prog1) (list (quote car) (
  71. cadr l)) (list (quote setq) (cadr l) (
  72. list (quote cdr) (cadr l)))))))
  73. (mcons macro (nlambda l (replace l (
  74. cond ((atom (cddr l)) (cadr l)) (t (
  75. list (quote cons) (cadr l) (cons (
  76. quote mcons) (cddr l))))))))
  77. (ncons macro (nlambda l (replace l (
  78. list (quote cons) (cadr l) nil))))
  79. (xcons macro (nlambda l (replace l (
  80. list (quote cons) (car (cddr l)) (
  81. cadr l)))))
  82. (function macro (nlambda l (replace l 
  83. (list (quote quote) (cadr l)))))
  84. (f:l macro (nlambda l (replace l (
  85. list (quote quote) (cons (quote 
  86. lambda) (cdr l))))))
  87. (q:l macro (nlambda l (replace l (
  88. list (quote quote) (cons (quote 
  89. lambda) (cdr l))))))
  90. (neq macro (nlambda l (replace l (
  91. list (quote not) (list (quote eq) (
  92. cadr l) (car (cddr l)))))))
  93. (macros value (expand no-expand 
  94. macro-expansion for selectq replace 
  95. if while repeat let local incr decr 
  96. push pop mcons ncons xcons function 
  97. f:l q:l neq macros))
  98. nil
  99.